home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb7.arc / ASYNC.PAS next >
Pascal/Delphi Source File  |  1985-02-06  |  13KB  |  270 lines
  1. {
  2.                          ASYNC
  3.  
  4.                Turbo Pascal Asynch Functions
  5.  
  6. These functions provide the ability to write to and read
  7. from either Asynch adapter, asynchronously. A hardware
  8. interrupt procedure is included to handle asynchronous or
  9. unsolicited input. The associated functions to Open and
  10. Close are also included.
  11.  
  12. This file must be included as part of the main Pascal program
  13. (NOT as part of a procedure as the variables contained here
  14. must be static).
  15.  
  16. IBM Internal Use Only.
  17. Mike Halliday. FLYMIKE @ YKTVMZ.
  18. }
  19.  
  20. Type tComPort =  (Com1, Com2);
  21.      tBaud = (b110, b150, b300, b600, b1200, b2400, b4800, b9600);
  22.      tParity = (pSpace, pOdd, pMark, pEven, pNone);
  23.      tDatabits = (d5, d6, d7, d8);
  24.      tStopbits = (s1, s2);
  25.  
  26. Type tSaveVector = record     {  Saved Com interrupt vector          }
  27.        IP: integer;
  28.        CS: integer;
  29.      end;
  30. Type regpak =
  31.            record AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS:integer end;
  32.  
  33. Const ourDS: integer = -1;    {  Will be init to contents of our DS
  34.                                   for later use in Interrupt routine  }
  35.  
  36.                          {  Define address adders for the various
  37.                              Async card registers.                    }
  38. Const RBR = $00;         { xF8   Receive Buffer Register             }
  39.       THR = $00;         { xF8   Transmitter Holding Register        }
  40.       IER = $01;         { xF9   Interrupt Enable Register           }
  41.       IIR = $02;         { xFA   Interrupt Identification Register   }
  42.       LCR = $03;         { xFB   Line Control Register               }
  43.       MCR = $04;         { xFC   Modem Control Register              }
  44.       LSR = $05;         { xFD   Line Status Register                }
  45.       MSR = $06;         { xFE   Modem Status Register               }
  46.       DLL = $00;         { xF8   Divisor Latch Least Significant     }
  47.       DLM = $01;         { xF9   Divisor Latch Most  Significant     }
  48.                          {       ASynch Interrupt Masks              }
  49.       imlist: array[Com1..Com2] of integer = ($EF, $F7);
  50.                               {  ASynch hardware interrupt addresses }
  51.       ivlist: array[Com1..Com2] of integer = ($000C, $000B);
  52.       PICCMD = $20;           {  8259 Priority Interrupt Controller  }
  53.       PICMSK = $21;           {  8259 Priority Interrupt Controller  }
  54.  
  55.                               {  Asynch base port addresses are
  56.                                   in the ROM BIOS data area           }
  57. Var   ComBaseAddr: array[Com1..Com2] of integer Absolute $0040:$0000;
  58.  
  59. {
  60.     Define a ring buffer for Asynch_Interrupt to write into
  61.     and ReadCom to read from.
  62. }
  63. Var ringbuf: array[0..255] of char;
  64.     readptr, writptr: 0..255; {  Index which ReadCom will next read from
  65.                                   Index which Asunch_Interrupt will next
  66.                                   write into. If readptr=writptr then
  67.                                   the buffer is empty.                }
  68.  
  69. Var LSRstat: byte;                     {  Line Status Reg at interrupt        }
  70.     ComSaveVec: tSaveVector;           {  saved Async Interrupt vector        }
  71.     ComBase :integer;                  {  Opened Com port base address        }
  72.     ActiveComPort: tComPort;           {  Opened Com                          }
  73.     imvalue: integer;                  {  Interrupt Mask value in use         }
  74.  
  75. Procedure SwapIntVector(IntVect: integer;
  76.                         Var SaveVector: tSaveVector);
  77. Var   dosregs: regpak;
  78. Begin
  79.   inline($FA);                          {  cli        disable interrupts       }
  80.  
  81.   With dosregs Do Begin
  82.     ax := ($35 * 256) + IntVect;
  83.     MsDos(dosregs);                     {  DOS function 35 - get vector        }
  84.     ds := SaveVector.CS;
  85.     dx := SaveVector.IP;
  86.     SaveVector.CS := es;
  87.     SaveVector.IP := bx;
  88.     ax := ($25 * 256) + IntVect;
  89.     MsDos(dosregs);                     {  DOS function 25 - set vector        }
  90.   End;
  91.   inline($FB);                          {  sti        re-enable ints           }
  92. End;
  93.  
  94. {       This routine gets control upon an Asynch Interrupt           }
  95.  
  96. Procedure Asynch_Interrupt;
  97. Var dummy: array[1..8] of integer; {  Leave room for our push's      }
  98.     MSRstat, IIRreg: byte;
  99. Begin
  100. {
  101.                              BP-4   Return IP
  102.                              BP-2   Return CS
  103.                              BP---> Caller's BP
  104. }
  105.                                         {  Push regs but DON'T enable - we can't
  106.                                   handle another interrupt now        }
  107.   inline($50/$53/$51/$52/$57/$56/$06);
  108.   inline($1E);                          {  push   ds       save ds, also       }
  109.   inline($2E/$8E/$1E/ourDS);            {  mov   DS,CS:ourDS  ;Setup our DS    }
  110.  
  111.   IIRreg := PORT[ComBase + IIR];        {  Get Interrupt Identification        }
  112.   If (IIRreg and $01) = 0 then Begin    {  If interrupt pending                }
  113.     IIRreg := IIRreg and $06;           {  Leave bits 2 and 1 on               }
  114.     Case IIRreg of                      {  Determine cause of interrupt (we
  115.                                            actually only expect (and handle)
  116.                                            the Data Available interrupt        }
  117.  
  118.       $04: Begin                        {  Received Data Available Interrupt   }
  119.              If LSRstat = 0 then Begin  {  If Line Status is OK                }
  120.                                         {  If there is Room in Buffer          }
  121.                If (SUCC(writptr) mod 256) <> readptr then Begin
  122.                                         {  Receive byte into our buffer        }
  123.                  ringbuf[writptr] := CHR(PORT[ComBase + RBR]);
  124.                                         {  Increment writptr                   }
  125.                  writptr := SUCC(writptr) mod 256;
  126.                End
  127.                                         {  If buffer full, pretend overrun     }
  128.                Else LSRstat := (LSRstat or $02);
  129.              End;
  130.            End;
  131.       $06: LSRstat := PORT[ComBase + LSR] and $1E;
  132.       $02: Begin End;
  133.       $00: MSRstat := PORT[ComBase + MSR];
  134.       Else Begin End;
  135.     End;  {  Case  }
  136.   End;
  137.   PORT[PICCMD] := $20;                  {  Send End Of Interrupt to 8259       }
  138.  
  139.   inline($1F);                          {  pop    ds                           }
  140.   inline($07/$5E/$5F/$5A/$59/$5B/$58);  {  pop rest of regs                    }
  141.   inline($89/$EC);                      {  mov    sp,bp                        }
  142.   inline($5D);                          {  pop    bp                           }
  143.   inline($CF);                          {  iret       ;Return from interrupt   }
  144. End;
  145.  
  146.  
  147. {                     Open COM1 or COM2, a la Basic                  }
  148.  
  149. Procedure OpenCom(ComPort: tComPort;
  150.                   Baud: tBaud;
  151.                   Parity: tParity;
  152.                   Databits: tDatabits;
  153.                   Stopbits: tStopbits);
  154. Const baudcode: array[b110..b9600] of integer =
  155.                            ($417, $300, $180, $C0, $60, $30, $18, $0C);
  156.       paritycode: array[pSpace..pNone] of byte =
  157.                                              ($38, $08, $28, $18, $00);
  158.       databitscode: array[d5..d8] of byte = ($00, $01, $02, $03);
  159.       stopbitscode: array[s1..s2] of byte = ($00, $04);
  160. Var   LCRreg: byte;
  161.  
  162. Begin
  163.                                         {  Init the Const "ourDS" for use by
  164.                                            the Async_Interrupt routine         }
  165.   inline($1E);                          {  push   ds                           }
  166.   inline($2E/$8F/$06/ourDS);            {  cs:pop ourDS                        }
  167.                                         {  Swap Com interrupt vector           }
  168.   With ComSaveVec Do Begin
  169.     CS := CSEG;
  170.     IP := OFS(Asynch_Interrupt);
  171.   End;
  172.   SwapIntVector(ivlist[ComPort], ComSaveVec);
  173.   ActiveComPort := ComPort;
  174.           inline($CD/$01);
  175.   ComBase := ComBaseAddr[ComPort];
  176.   LSRstat := 0;                         {  Reset LSR status          }
  177.   imvalue := imlist[ComPort];           {  Select Interrupt Mask val }
  178.   ComBase := ComBaseAddr[ComPort];      {  Select Input Port         }
  179.   readptr := 0;                         {  Init buffer pointers      }
  180.   writptr := 0;                         {  Init buffer pointers      }
  181.   PORT[PICMSK] := PORT[PICMSK] and imvalue;  {  Enable ASynch Int    }
  182.   PORT[IER+ComBase] := $01;             {  Enable some interrupts    }
  183.                               { Note: OUT2, despite documentation,
  184.                                  MUST be ON, to enable interrupts     }
  185.   PORT[MCR+ComBase] := $0B;             {  Set RTS, DTR, OUT2        }
  186.   LCRreg := $80;              {  Set Divisor Latch Access Bit in LCR }
  187.   LCRreg := LCRreg or paritycode[Parity];    {  Setup Parity         }
  188.   LCRreg := LCRreg or databitscode[Databits];{  Setup # data bits    }
  189.   LCRreg := LCRreg or stopbitscode[Stopbits];{  Setup # stop bits    }
  190.   PORT[LCR+ComBase] := LCRreg;     {  Set Parity, Data and Stop Bits
  191.                                        and set DLAB                   }
  192.   PORT[DLM+ComBase] := Hi(baudcode[Baud]);   {  Set Baud rate        }
  193.   PORT[DLL+ComBase] := Lo(baudcode[Baud]);   {  Set Baud rate        }
  194.   PORT[LCR+ComBase] := LCRreg and $7F;  {  Reset DLAB                }
  195.           inline($CD/$01);
  196. End;
  197.  
  198.  
  199. {                 Close any initialized COM                          }
  200.  
  201. Procedure CloseCom;
  202. Begin
  203.                               {  Disable Async interrupt             }
  204.   PORT[PICMSK] := PORT[PICMSK] or ($FF - imvalue);
  205.   PORT[IER+ComBase] := $00;   {  Disable Data Avail interrupt        }
  206.                               {  Restore Com interrupt vector        }
  207.   SwapIntVector(ivlist[ActiveComPort], ComSaveVec);
  208. End;
  209.  
  210. {
  211. Read a stream of data from the initialized COM port. If Line
  212. Status is not currently zero, then return immediately with
  213. the Line Status byte. If there is no data currently in the
  214. buffer then return stream:=null with function:=0. If there
  215. is data in the buffer, then return all the data up to, but
  216. not including, a CR($0D). If a CR is not found in the buffer
  217. then loop here until one arrives.
  218. }
  219.  
  220. Function  ReadCom(var stream: lstring): byte;{  Returned LSR, or zero}
  221.  
  222.   Function  ReadChar: char;   {  Return char, or SPIN !!!!           }
  223.   Begin
  224.     If readptr = writptr then
  225.                            Repeat Begin End Until (readptr <> writptr);
  226.     ReadChar := ringbuf[readptr];
  227.     readptr := SUCC(readptr) mod 256;
  228.   End;
  229.  
  230. Begin
  231.   stream[0] := CHAR($00);          {  Init returned string to null   }
  232.   ReadCom := LSRstat;              {  Return LSR, or zero            }
  233.   If LSRstat = 0 then Begin
  234.     If readptr <> writptr then Begin    {  If buffer not empty       }
  235.       Repeat Begin                      {  Get chars from ring buffer}
  236.                                    {  Increment returned string len  }
  237.         stream[0] := CHAR(ORD(SUCC(stream[0])));
  238.                                    {  Get a char from buffer, or SPIN}
  239.         stream[ORD(stream[0])] := ReadChar;
  240.       End
  241.       Until (stream[ORD(stream[0])] = CHR($0D));  {  Until see a CR  }
  242.       stream[0] := CHR(ORD(stream[0]) - 1);       {  strip the CR    }
  243.     End;
  244.   End;
  245. End;
  246.  
  247. {
  248. Write a stream of data to the initialized COM port, then
  249. append a CR and LF.
  250. }
  251.  
  252. Procedure WriteCom(stream: lstring);
  253. Var LSRreg: byte;
  254.     i: integer;
  255. Begin
  256.   inline($FA);                {  disable interrupts until we get all
  257.                                   the data sent.                      }
  258.   For i := 1 to LENGTH(stream) Do Begin
  259.                               {  Spin until Transmitter Holding
  260.                                   Register (THRE) is empty            }
  261.     Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  262.     PORT[THR+ComBase] := ORD(stream[i]);     {  Output the caharacter}
  263.   End;
  264.   Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  265.   PORT[THR+ComBase] := $0D;   {  Output a CR                         }
  266.   Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  267.   PORT[THR+ComBase] := $0A;   {  Output a LF                         }
  268.   inline($FB);                {  Reenable interrupts                 }
  269. End;
  270.